Merging World Endangered Language data with GDP per Capita

Worldbank GDP per capita data

Data source from worldbank GDP per capita in current USD value. We using per capita value to normalized against each country population for comparison between countries. The data is then unstack and merge with the data set setup earlier with Barro-Lee’s education statistics.

PCA plot

We added in GDP data and perform PCA again. PC2 and PC3 shows hyper-plane that is in 3-D with a slight slope when mapped to 2 dimension. Drawing a 3-D plot including PC 1, 2 and 3 shows a better view on these hyper-planes.

pca.data<-as.matrix(new.ext %>% select( Elevation, Number.of.speakers.log, GDP.per.capita.log, `Female.75+.completed.secondary`))

rownames(pca.data)<-as.character(new.ext$Degree.of.endangerment)
pca.barrolee <- princomp(apply(pca.data, 2, rank))
lambda <- (pca.barrolee$sdev)^2 
propvar <- round(lambda / sum(lambda) * 100, 0)

3D PCA plot on PC1, PC2 and PC3

The 3-D scatter plot shows the weight of each generation vulnerability clustering. The green points with vulnerability on generation 1 (grandparents) and generation 2 (parents) are clustered together with some cross over to blue region that covers generation 3 (children). The red (extinct) are clearly on its plane (mainly due to number of speakers for extinction is 0, which is clearly separable to the others)

color<-c(rep(rgb(0,0,1, 0.3), 2), rep(rgb(0,1,0, 0.3), 2), rgb(1,0,0, 0.3))
camera<-list(eye=list(x = -1.8, y = 0.8, z = 0.2))
scene = list(
  xaxis=list(title="PCA1"), yaxis=list(title="PCA2"),
  zaxis=list(title="PCA3"),
  camera = camera)
plot_ly(x = pca.barrolee$scores[,1], 
             y = pca.barrolee$scores[,2], 
             z = pca.barrolee$scores[,3], 
             color = factor(rownames(pca.barrolee$scores),
                                    levels=c("Vulnerable", 
                                             "Definitely endangered", 
                                             "Severely endangered", 
                                             "Critically endangered", "Extinct")), colors = color) %>%
  add_markers(opacity=0.3, marker=list(size=rep(7, nrow(pca.data)))) %>% layout(scene=scene)

PCA plot on PC2 and PC3

Slope on projection to PC2 and PC3 plane suggest a 3 D view.

plotPCA(2,3, pca.barrolee, color)

PCA plot on PC1 and PC3

PCA plot on PC1 and PC2

plotPCA(1,2, pca.barrolee, color)

PCA Biplot

The biplot shows Elevation and Number of speakers are closely related with degree between the 2 vectors to be small, moving towards same direction and magnitude. It is also orthogonal (independence) in respect to the other 2 variables, GDP per capita and Percentage of female 75+ population that completed secondary school.

biplot(pca.barrolee, xlabs = rep('', nrow(pca.data)), cex=0.6)

pca.barrolee$loadings

Loadings:
                               Comp.1 Comp.2 Comp.3 Comp.4
Elevation                      -0.307 -0.659  0.685       
Number.of.speakers.log         -0.332 -0.599 -0.728       
GDP.per.capita.log              0.639 -0.281        -0.715
Female.75+.completed.secondary  0.621 -0.357         0.697

               Comp.1 Comp.2 Comp.3 Comp.4
SS loadings      1.00   1.00   1.00   1.00
Proportion Var   0.25   0.25   0.25   0.25
Cumulative Var   0.25   0.50   0.75   1.00

Draftman’s Plot

The Draftman’s plot shows Number of speakers are clearly having direct relation with the vulnerability, which is expected as lower numbers of speakers contribute directly on the spread of the language. However, the plot against Number of speakers versus Percentage of 75+ female population that completed secondary school shows a break in blue points (generation 3 or young children). Supporting our argument that generation 1 (grandparents) population with secondary education are showing evidence of shift to national language as main communication with their children. Taking a breaking point of percent 75+ female population that completed secondary school at 30% yields a 23% of languages with vulnerability on generation 3 (blue points) compared with 53% of total languages that is with lower education penetration on generation 1 (grandparents).

color<-c(rep(rgb(0,0,1, 0.2), 2), rep(rgb(0,1,0, 0.2), 2), rgb(1,0,0, 0.2))
pairs(pca.data, pch=21, col=rgb(0,0,0,0),
      bg=color[unclass(factor(rownames(pca.data),levels=c("Vulnerable", "Definitely endangered", "Severely endangered", "Critically endangered", "Extinct")))])

Correlation on GDP vs Education

Even though is speculated that education level is highly correlated with GDP (economic growth), drawing a comparison between the 2 in log scale for education penetration level on generation 1 only explain 60% of economic growth based on GDP per capita. We argue that economic growth may be a driving force for generation 1 with higher education penetration to often use mainstream language for communication at home. This indirectly causing a breakage in cultural language transfer between generation.

color<-c(rep(rgb(0,0,1, 0.2), 2), rep(rgb(0,1,0, 0.2), 2), rgb(1,0,0, 0.2))
new.ext<- new.ext %>% mutate(`Female.75+.completed.secondary.log`=
                               ifelse(`Female.75+.completed.secondary`==0, 
                                      log(1), log(`Female.75+.completed.secondary`)))
plot(GDP.per.capita.log~`Female.75+.completed.secondary.log`,  data=new.ext, pch=21, col=rgb(0,0,0,0),
      bg=color[unclass(factor(new.ext$Degree.of.endangerment,levels=c("Vulnerable", "Definitely endangered", "Severely endangered", "Critically endangered", "Extinct")))])
lm.fit<-lm(GDP.per.capita.log~`Female.75+.completed.secondary.log`,  data=new.ext)
abline(lm.fit)

summary(lm.fit)

Call:
lm(formula = GDP.per.capita.log ~ `Female.75+.completed.secondary.log`, 
    data = new.ext)

Residuals:
    Min      1Q  Median      3Q     Max 
-4.2934 -0.6686  0.1462  0.6894  3.4807 

Coefficients:
                                     Estimate Std. Error t value Pr(>|t|)    
(Intercept)                          7.275826   0.010607   685.9   <2e-16 ***
`Female.75+.completed.secondary.log` 0.656306   0.004962   132.3   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.975 on 11217 degrees of freedom
Multiple R-squared:  0.6093,    Adjusted R-squared:  0.6093 
F-statistic: 1.749e+04 on 1 and 11217 DF,  p-value: < 2.2e-16

Appendix

require(reshape2)
require(dplyr)
filterByYearUnstack<-function(edstats.df, fromYear=1976, toYear=2016) {
  getYear<-function(yr) {
    as.numeric(gsub("X([0-9]{4})", "\\1", yr))
  }
  edstats.years<-data.frame()
  for(n in names(edstats)) {
    if (grepl("X[0-9]{4}", n) && getYear(n) >=fromYear && getYear(n) <= toYear)
      edstats.years<-rbind(edstats.years, edstats.df %>% 
                             dcast(Country.Code~Indicator.Name, value.var= n) %>% 
                             mutate(year=gsub("X([0-9]{4})", "\\1", n)))
  }
  edstats.years
}

ext.lang.elevation<-readRDS(file="collected_data/ext.lang.elevation.country.normalized.RDS")
edstats.barrolee.l<-readRDS("./collected_data/edstats.barrolee.RDS")
gdp.capita<-read.csv("../input/API_NY-GDPperCapita/API_NY.GDP.PCAP.CD_DS2_en_csv_v2.csv", skip = 4)
doe.levels<-levels(factor(ext.lang.elevation$Degree.of.endangerment,
                   levels=c("Vulnerable", "Definitely endangered", 
                            "Severely endangered", "Critically endangered", "Extinct")))
gdp.capita<-filterByYearUnstack(gdp.capita, 1990, 2010)
ed.gdp<-merge(edstats.barrolee.l, gdp.capita, by=c("Country.Code", "year"), all.x=T) %>% 
  filter(!is.na(`GDP per capita (current US$)`))
ctr.diff<-setdiff(ext.lang.elevation$Country.codes.alpha.3.coord, edstats.barrolee.l$Country.Code)
new.ext<-ext.lang.elevation %>% filter(!(Country.codes.alpha.3.coord %in% ctr.diff)) %>%
  filter(!is.na(Number.of.speakers)) %>%
  select(ID, Degree.of.endangerment, Name.in.English, Number.of.speakers, elevation, Country.codes.alpha.3.coord )
new.ext<-new.ext %>% mutate(Number.of.speakers.log = ifelse(Number.of.speakers==0, log(1), log(Number.of.speakers)))
## Merge for all years
new.ext<-merge(new.ext, ed.gdp, by.x="Country.codes.alpha.3.coord",
               by.y = "Country.Code", all.x=T) %>% select ( - matches("year") )
new.ext<-new.ext %>% mutate(GDP.per.capita.log = log(`GDP per capita (current US$)`))
new.ext<-new.ext %>% mutate( `Female.75+.completed.secondary.log` = log(`Barro-Lee: Percentage of female population age 75+ with secondary schooling. Completed Secondary`))
new.ext<-new.ext %>% mutate( `Female.75+.completed.secondary` = `Barro-Lee: Percentage of female population age 75+ with secondary schooling. Completed Secondary`)
new.ext<-new.ext %>% select(-starts_with("Barro-Lee:"))
new.ext<-new.ext %>% plyr::rename(c("Country.codes.alpha.3.coord" = "Country.Code", "elevation" = "Elevation"))

plotPCA<-function(f, s, pca.barrolee, color, titl=TRUE) {
  plot(pca.barrolee$scores[,f], pca.barrolee$scores[,s], pch=21,
       xlab=paste(c("PC",f,"(",propvar[f],"%)"), collapse=""),
       ylab=paste(c("PC",s,"(",propvar[s],"%)"), collapse=""),
       col=rgb(0,0,0,0), bg=color[unclass(factor(new.ext$Degree.of.endangerment,
       levels=c("Vulnerable", "Definitely endangered", "Severely endangered", 
                "Critically endangered", "Extinct")))])
  legend("bottomright", doe.levels, col=color,
         cex=0.7,
         pch=rep(19, length(doe.levels)))
  if (titl)
    title(paste("PCA PC", f," and PC", s, sep=""))
}